Attribute VB_Name = "modGeneral"
Option Explicit

'\\bxw2105_01

Public objReg As clsRegistry
'Public objAdoConn As clsAdoConnection
Public objAdoConn As Object

'ERROR CONSTANTS
'If data is extracted to a file correctly, the no of records extracted is returned
Public Const NO_DATA_TO_EXTRACT As Long = 0
Public Const DATABASE_CONNECTION_FAILED As Long = -1
Public Const ERROR_CREATING_HEADER_RECORD As Long = -2
Public Const ERROR_CREATING_FOOTER_RECORD As Long = -3
Public Const ERROR_READING_RECORDS As Long = -4
Public Const UNKNOWN_ERROR As Long = -5
Public Const NO_VALID_DESTINATION_FOLDER As Long = -6

Public lngErrorCount As Long
Public strErrorString As String


Public Const SQL_DB As String = "SQLOLEDB.1"
Public Const ORA_DB As String = "MSDAORA.1"

'Registry Function Prototypes
Declare Function RegOpenKeyEx Lib "advapi32" _
  Alias "RegOpenKeyExA" ( _
  ByVal hKey As Long, _
  ByVal lpSubKey As String, _
  ByVal ulOptions As Long, _
  ByVal samDesired As Long, _
  phkResult As Long _
) As Long

Declare Function RegQueryValueEx Lib "advapi32" _
  Alias "RegQueryValueExA" ( _
  ByVal hKey As Long, _
  ByVal lpValueName As String, _
  ByVal lpReserved As Long, _
  ByRef lpType As Long, _
  ByVal szData As String, _
  ByRef lpcbData As Long _
) As Long

Declare Function RegCloseKey Lib "advapi32" ( _
  ByVal hKey As Long _
) As Long

Type TSECURITY_ATTRIBUTES
  nLength As Long
  lpSecurityDescriptor As Long
  bInheritHandle As Boolean
End Type


Declare Function RegCreateKeyEx Lib "advapi32" _
  Alias "RegCreateKeyExA" ( _
  ByVal hKey As Long, _
  ByVal lpSubKey As String, _
  ByVal Reserved As Long, _
  ByVal lpClass As String, _
  ByVal dwOptions As Long, _
  ByVal samDesired As Long, _
  lpSecurityAttributes As TSECURITY_ATTRIBUTES, _
  phkResult As Long, _
  lpdwDisposition As Long _
) As Long



Declare Function RegSetValueEx Lib "advapi32" _
  Alias "RegSetValueExA" ( _
  ByVal hKey As Long, _
  ByVal lpValueName As String, _
  ByVal Reserved As Long, _
  ByVal dwType As Long, _
  ByVal szData As String, _
  ByVal cbData As Long _
) As Long

Public Sub TokenizeString(strSearch As String, strSeparator As String, daResult() As Variant)
    Dim Pos As Integer
    Dim strNew As String
    Dim iArrayCounter As Integer

    iArrayCounter = 0
    strNew = strSearch
    Pos = InStr(1, strSearch, strSeparator)
    Do While Pos <> 0
        ReDim Preserve daResult(iArrayCounter)
        daResult(iArrayCounter) = Left(strNew, Pos - 1)
        strNew = Right(strNew, Len(strNew) - Pos)
        iArrayCounter = iArrayCounter + 1
        Pos = InStr(1, strNew, strSeparator)
    Loop
        ReDim Preserve daResult(iArrayCounter)
        daResult(iArrayCounter) = strNew
    'TokenizeString = daResult
End Sub

Public Function Encrypt(ByVal strText As String, _
                        ByVal strCipher As String) As String
  Dim lngIndex As Long
  Dim strEncryptedText As String
  Dim lngCipherLength As Long
  Dim strTextArray() As String
  Dim lngHolder As Long
  Dim strTextHolder As String
  Dim strTextToLongHolder As String
  Dim i As Long


  'check to see if the text sent in is a bunch of numbers
  lngHolder = Val(strText)
  If lngHolder = 0 Then 'this is a string that does not need conversion from the character codes back to a string
    strTextHolder = strText
  Else 'this is a long that needs to be converted back to a string
    ReDim strTextArray(0)

    strTextArray = Split(strText, "~", -1)
    For i = 0 To UBound(strTextArray) - 1
        strTextHolder = strTextHolder & Chr(strTextArray(i))
    Next
  End If
  'both the return and the Text to encrypt need to be longs so
    'that they are not truncated when
  'they get saved or displayed

  'convert the Text to a long

  lngCipherLength = Len(strCipher)

  Do Until Len(strEncryptedText) = Len(strTextHolder)
    For lngIndex = 1 To lngCipherLength

      ' We are done when the two strings are equal in length
      If Len(strEncryptedText) = Len(strTextHolder) Then
        Exit For
      End If

      ' Perform the XOR encryption
      strEncryptedText = strEncryptedText & _
        Chr(Asc(Mid(strTextHolder, Len(strEncryptedText) + 1, 1)) Xor _
        Asc(Mid(strCipher, lngIndex, 1)))
    Next lngIndex
  Loop

  'check the the return value if its a decrypted string COOL

  If lngHolder <> 0 Then ' this is a decrypted string
    ' Return the encrypted/decrypted text
    Encrypt = strEncryptedText
  Else 'this is an encrypted string and needs to be converted to longs
    For i = 1 To Len(strEncryptedText)
        strTextToLongHolder = strTextToLongHolder & Asc(Mid$(strEncryptedText, i, 1)) & "~"
    Next
    'return the long'ed encrypted string
    Encrypt = strTextToLongHolder
  End If

End Function
Sub Main()

    

    frmTest.Show

End Sub

Public Sub HandleError(strErrNumber As String, strErrDesc As String, strLocation As String, Optional strFreeText As String, Optional lngRecNo As Long)

    Dim FNum As Long
    Dim FName As String
    Dim strErrPathFile As String
    
    On Error GoTo HandleErrorFix
    'Tina... check this.. extra \ in path
    'strErrPathFile = objReg.ErrorFileLocation & "\KtExtract" & Format(Date, "ddmmyyyy") & ".err"
    strErrPathFile = objReg.ErrorFileLocation & "KtExtract" & Format(Date, "ddmmyyyy") & ".err"

'    If lngRecNo <> 0 Then
'        'Set ErrorDetails.colExtractFileLineNo.Count = ErrorDetails.colExtractFileLineNo.Count + 1
'        ErrorDetails.colExtractFileLineNo.Add lngRecNo
'        strErrorString = Chr(13) & strErrorString & "Record number: " & lngRecNo & " was not written to the Extract File due to the following error."
'    End If
    
    strErrorString = Chr(13) & strErrorString & strErrNumber & " - " & strErrDesc & " occurred in " & strLocation & "." & Chr(10)
    strErrorString = strErrorString & " while writing to file: " & objReg.AsciiFileDest & objReg.AsciiFileName
    lngErrorCount = lngErrorCount + 1
    
    FNum = FreeFile
    FName = strErrPathFile
    
    Open FName For Append As FNum
    Write #FNum, strErrorString
    Close #FNum

    
    MsgBox strErrNumber & " - " & strErrDesc & " occurred in " & strLocation & ".", vbCritical, "KtExtract"
    
    Exit Sub
HandleErrorFix:
    'IF THE SPECIFIED DIRECTORY DOESN'T EXIST CREATE IT, THEN OPEN/CREATE THE FILE
    If Err.Number = 76 Then
        MkDir strErrPathFile
        Open strErrPathFile For Append Access Write As #FNum
            Write #FNum, strErrorString
        Close #FNum
    Else
        'MsgBox "WriteFile: " & Err.Number & " - " & Err.Description, vbExclamation, "Directory Clean Up"
        HandleError Err.Number, Err.Description, "WriteFile"
    End If
    
    
End Sub
Public Function ValidateFolder(strFolderToValidate As String) As Boolean

    Dim strDirExists As String
    Dim strAnswer As String

    On Error GoTo ValidateFolderFix

    If Dir(strFolderToValidate, vbDirectory) = "" Then
        Screen.MousePointer = vbDefault
        strAnswer = MsgBox("Directory: " & strFolderToValidate & " does not exist. " & Chr(10) & _
                    "Do you want create it?", vbYesNo, "Directory Clean Up")
        If strAnswer = vbYes Then
            CreateFolder strFolderToValidate
            ValidateFolder = True
        Else
            ValidateFolder = False
            Exit Function
        End If
    Else
        If Right(strFolderToValidate, 1) <> "\" Then
            strFolderToValidate = strFolderToValidate & "\"
        End If
        ValidateFolder = True
    End If
    If Len(strFolderToValidate) < 1 Then
        strFolderToValidate = ""
        ValidateFolder = False
    End If
    
    Exit Function
    
ValidateFolderFix:
    MsgBox "ValidateFolder: " & Err.Number & " - " & Err.Description, vbExclamation, "Directory Clean Up"
    ValidateFolder = False
End Function
Public Sub CreateFolder(strFolder)

    Dim intPos As Integer
    Dim strTemp As String
    
    If Dir(strFolder, vbDirectory) = "" Then
        If Right(strFolder, 1) <> "\" Then
            strFolder = strFolder & "\"
        End If
        intPos = InStr(1, strFolder, "\")
        strTemp = Left(strFolder, intPos)
        Do While intPos <> 0
            If Dir(strTemp, vbDirectory) = "" Then
                MkDir strTemp
            End If
            intPos = InStr(intPos + 1, strFolder, "\")
            strTemp = Left(strFolder, intPos)
        Loop
    End If



End Sub
